<p>
  Comparing subsets "<code><% $one %></code>" and "<code><% $other %></code>" within "<code><% $common %>"</code>
</p>
<table>
  <tr>
    <td colspan="2" style="color: white; background-color: #555">
      <b>Set "<code><% $one %></code>":</b>
    <td>
  </tr>
%       foreach my $tuple ( @set_one ) {
%         my ($set, $sample) = @$tuple;
%         my $filename = "$TRFLP::data_path/$set/$sample.peak";
              <tr>
                <td style="color: white; background-color: black">
                  <% "$set:<b>$sample</b>" %>
                </td>
                <td style="background-color: black"><img border="0" src="plot_heatmap.html?key=<% $sample %>;file=<% $filename %>"></td>
              </tr>
%       }
  <tr>
    <td colspan="2" style="color: white; background-color: #555">
      <b>Set "<code><% $other %></code>":</b>
    <td>
  </tr>
%       foreach my $tuple ( @set_two ) {
%         my ($set, $sample) = @$tuple;
%         my $filename = "$TRFLP::data_path/$set/$sample.peak";
              <tr>
                <td nowrap style="color: white; background-color: black">
                  <% "$set:<b>$sample</b>" %>
                </td>
                <td style="background-color: black"><img border="0" src="plot_heatmap.html?key=<% $sample %>;file=<% $filename %>"></td>
              </tr>
%       }
</table>

<h2>Binned peaks</h2>
<p>
  Threshold: <% $threshold %>; bin size (peak calling error): <% $error %>
</p>
<table border cellspacing="0">
%   foreach ( @matr ) {
%     my ($label, @data) = split "\t";
%     $label =~ s/\"//g;
   <tr style="background-color: <% $set_two{$label} ? '#ddd' : '#eee' %>">
%     if ( $label eq "length" ) {
     <td style="background-color: #ddd">&nbsp;</td>
     <td nowrap style="background-color: #ddd">&nbsp;<b>Total</b></td>
     <td nowrap style="background-color: #ddd">&nbsp;<b>Richness</b></td>
     <td nowrap style="background-color: #ddd">&nbsp;<b>Shannon <em>H</em></b></td>
     <td nowrap style="background-color: #ddd">&nbsp;<b>Evenness</em></b></td>
%     } else {
     <td><% $label %></td>
%       my $sum = 0;
%       my $S = 0;
%       my $H = 0;
%       foreach (@data) {
%         $sum += $_;
%         $H -= $_ * log($_) unless $_ == 0;
%         $S += 1 unless $_ == 0;
%       }
     <td><b><% sprintf("%4.2g", $sum) %></b></td>
     <td><b><% sprintf("%5.2g", $S) %></b></td>
     <td><b><% sprintf("%5.2g", $H) %></b></td>
     <td><b><% sprintf("%5.2g", $H/log($S)) %></b></td>
%     }
%     foreach my $value ( @data ) {
%       if ( $label eq "length" ) {
     <td style="background-color: #ddd"><% sprintf("%6.2f", $value) %></td>
%       } else {
     <td><% sprintf("%6.2g", $value) %></td>
%       }
%     }
   </tr>
%   }
</table>

<%args>
  $common
  $one
  $other
  $threshold => 2
  $error => 2
</%args>
<%init>
  my $query = qq(
SELECT sample_tag."set", sample_tag."id"
  FROM batch_tag, sample_tag
 WHERE sample_tag."set" = batch_tag."set"
   AND batch_tag."value" = '$common'
   AND sample_tag."key" = '$one'
);
  my $res = $Dbh->selectall_arrayref($query);
  $Dbh->err and die $Dbh->errstr . " in query: [$query]";
  my @set_one = @$res;
  my %set_one = map {$_ => 1} @$res;

  $query = qq(
SELECT sample_tag."set", sample_tag."id"
  FROM batch_tag, sample_tag
 WHERE sample_tag."set" = batch_tag."set"
   AND batch_tag."value" = '$common'
   AND sample_tag."key" = '$other'
);
  $res = $Dbh->selectall_arrayref($query);
  $Dbh->err and die $Dbh->errstr . " in query: [$query]";
  my @set_two = @$res;
  my %set_two = map {"$TRFLP::data_path/$_->[0]" . "/" . $_->[1] => 1} @$res;

  # -------------------------------------------------------------
  # cluster peaks combining the two sets
  my %Rname;
  my %R2Real;
  my $nsamp = 0;
  my $prefix = 'sample';
  my $color = 'B';
  my @filtered_list;
  my @matr;
  my @tag_list;
  foreach my $tuple ( @set_one, @set_two ) {
    my $sample = "$TRFLP::data_path/$tuple->[0]/$tuple->[1]";
    my @peaks = `cat $sample.abi`;
    next unless scalar @peaks >= 1;
    $nsamp++;
    push @filtered_list, $sample;
    $Rname{$sample} = "$prefix$nsamp";
    $R2Real{"$prefix$nsamp"} = $sample;
  }
  my $out_file = "$TRFLP::tmpdir/cluster.r";
  open OUTFILE, ">$out_file";

  print OUTFILE "\n\n";
  foreach my $sample ( @filtered_list ) {
    print OUTFILE <<END
$Rname{$sample} <- read.table(file="$sample.abi", col.names = c("Color", "time", "length", "height", "area", "point"))
$Rname{$sample}.$color <- cbind($Rname{$sample}\[grep("^$color", as.character($Rname{$sample}\$Color), perl = T), 3], $Rname{$sample}\[grep("^$color", as.character($Rname{$sample}\$Color), perl = T), 5])
$Rname{$sample}.$color <- cbind($Rname{$sample}.$color, $Rname{$sample}.$color\[,2]/sum($Rname{$sample}.$color\[,2]))

END
;

  }

  my $colored_list = join ", ", map {"$_.$color"} @Rname{@filtered_list};
  my $colnames = join ", ", qq("length"), map {qq("$_")} @filtered_list;
  print OUTFILE qq(
$color.list <- list($colored_list)
$color.Data <- Gfiltering.ftn($color.list, $threshold)
$color.ClusBin <- GclustBin.ftn($color.Data[[1]], $error)
ClustBin <- rbind(B.ClusBin)
write.table(t($color.ClusBin), file="$TRFLP::tmpdir/ClusBinMatrix.txt", sep="\\t", row.names=c($colnames), col.names=F)
);

close OUTFILE;

my $cmd =  "cat $TRFLP::bin/FilteringandBinning.r $TRFLP::tmpdir/cluster.r | R --vanilla --slave >& $TRFLP::tmpdir/R.log";
die "couldn't run command: $cmd; reason: $!" unless system($cmd) == 0;

@matr = `cat $TRFLP::tmpdir/ClusBinMatrix.txt`;
</%init>
